Prototype Testing

pacman::p_load(sf, tmap, tidyverse,readxl)

mpsz <- st_read(dsn = "data/geospatial", 
                layer = "MP14_PLNG_AREA_WEB_PL")

Reading layer `MP14_PLNG_AREA_WEB_PL' from data source 
  `/Users/geloliu/Gelo-608/ISSS608/ISSS608-VAA-GroupProject/ShinyApp/data/geospatial' 
  using driver `ESRI Shapefile'
Simple feature collection with 55 features and 12 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 2667.538 ymin: 15748.72 xmax: 56396.44 ymax: 50256.33
Projected CRS: SVY21

age <- read_csv("data/ResidentPopulationbyPlanningAreaSubzoneofResidenceAgeGroupandFloorAreaofResidenceCensusofPopulation2020.csv")

Rows: 388 Columns: 121
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (121): Number, Total1_Total, Total1_0_4, Total1_5_9, Total1_10_14, Total...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

income <- read_excel("data/ResidentHouseholdsbyPlanningAreaofResidenceandMonthlyHouseholdIncomefromWorkCensusOfPopulation2020.xlsx",sheet = "sheet1",range="A11:U43")

age <- age %>%
  filter(grepl("Total", Number, ignore.case = TRUE)) %>%  
  select(1:21) %>%
  replace(. == "-", NA) %>%
  mutate(across(2:21, as.numeric)) %>%
  mutate(Aged = rowSums(select(., 16:21), na.rm = TRUE)) %>%
  mutate(PA = sub(" - Total.*", "", Number))%>%
  select(c("PA","Aged","Total1_Total"))%>%
  mutate(`Aged%` = round(Aged/Total1_Total*100,0),
         PA = toupper(PA))

age <- left_join(mpsz,age,by = c("PLN_AREA_N" = "PA"))

income <- income %>%
  mutate(across(2:21, as.numeric))
income_proportion <- income %>%
  mutate(across(3:21, ~ round(. / income[[2]] * 100, 2))) %>%
  mutate(`LowerIncome%`=rowSums(select(.,3:6), na.rm = TRUE))
low_income <- income_proportion %>%
  select(c(`Planning Area of Residence`,`LowerIncome%`))%>%
  mutate(`Planning Area of Residence` = toupper(`Planning Area of Residence`))

low_income <- left_join(mpsz,low_income,by = c("PLN_AREA_N" = "Planning Area of Residence"))

# Ensure both layers have the same CRS
low_income <- st_transform(low_income, st_crs(age))

# Set the tmap mode to view (interactive)
tmap_mode("view")

ℹ tmap mode set to "view".

# Create the map with multiple layers
tm_shape(age) +
  tm_fill(col = "Aged%", 
          palette = "Blues", 
          title = "Aged Population(%)",
          alpha = 0.9,
          style = "quantile") +
  tm_borders(col = "white", lwd = 0.5, alpha = 0.5) +
tm_shape(low_income) + 
  tm_fill(col = "LowerIncome%", 
          palette = "YlOrRd", 
          title = "IncomeBelow:3000(%)", 
          style = "quantile",
          n = 5,
          alpha = 0.6) +
  tm_borders(col = "darkgrey", lwd = 0.5, alpha = 0.5) +
tm_basemap(server = "CartoDB.Positron") +
tm_layout(title = "Aged and Low-Income Population Across Singapore", 
          legend.outside = TRUE,
          legend.outside.position = "right")

── tmap v3 code detected ───────────────────────────────────────────────────────
[v3->v4] `tm_polygons()`: instead of `style = "quantile"`, use fill.scale =
`tm_scale_intervals()`.
ℹ Migrate the argument(s) 'style', 'palette' (rename to 'values') to
  'tm_scale_intervals(<HERE>)'[v3->v4] `tm_polygons()`: use 'fill' for the fill color of polygons/symbols
(instead of 'col'), and 'col' for the outlines (instead of 'border.col').[v3->v4] `tm_polygons()`: use `fill_alpha` instead of `alpha`.[v3->v4] `tm_polygons()`: migrate the argument(s) related to the legend of the
visual variable `fill` namely 'title' to 'fill.legend = tm_legend(<HERE>)'[v3->v4] `tm_borders()`: use `fill_alpha` instead of `alpha`.[v3->v4] `tm_polygons()`: use `fill_alpha` instead of `alpha`.[v3->v4] `tm_polygons()`: migrate the argument(s) related to the legend of the
visual variable `fill` namely 'title' to 'fill.legend = tm_legend(<HERE>)'[v3->v4] `tm_borders()`: use `fill_alpha` instead of `alpha`.[v3->v4] `tm_layout()`: use `tm_title()` instead of `tm_layout(title = )`[cols4all] color palettes: use palettes from the R package cols4all. Run
`cols4all::c4a_gui()` to explore them. The old palette name "Blues" is named
"brewer.blues"Multiple palettes called "blues" found: "brewer.blues", "matplotlib.blues". The first one, "brewer.blues", is returned.
[cols4all] color palettes: use palettes from the R package cols4all. Run
`cols4all::c4a_gui()` to explore them. The old palette name "YlOrRd" is named
"brewer.yl_or_rd"Multiple palettes called "yl_or_rd" found: "brewer.yl_or_rd", "matplotlib.yl_or_rd". The first one, "brewer.yl_or_rd", is returned.

pacman::p_load(ggdist,ggridges,lubridate,knitr)

station<-read_csv("data/Singapore_daily_records.csv")

Rows: 22230 Columns: 13
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (1): station
dbl (12): year, month, day, daily_rainfall_total_mm, highest_30_min_rainfall...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

pacman::p_load(dplyr, lubridate)

station <- station %>%
  mutate(
    mean_temperature_c = ifelse(is.na(mean_temperature_c), mean(mean_temperature_c, na.rm = TRUE), mean_temperature_c),
    maximum_temperature_c = ifelse(is.na(maximum_temperature_c), mean(maximum_temperature_c, na.rm = TRUE), maximum_temperature_c),
    minimum_temperature_c = ifelse(is.na(minimum_temperature_c), mean(minimum_temperature_c, na.rm = TRUE), minimum_temperature_c),
    date = make_date(year, month, day),
    station = as.factor(station)
  ) %>%
  mutate(across(where(is.character), as.numeric)) 

str(station)

tibble [22,230 × 14] (S3: tbl_df/tbl/data.frame)
 $ station                    : Factor w/ 10 levels "Admiralty","Ang Mo Kio",..: 9 9 9 9 9 9 9 9 9 9 ...
 $ year                       : num [1:22230] 2019 2019 2019 2019 2019 ...
 $ month                      : num [1:22230] 1 1 1 1 1 1 1 1 1 1 ...
 $ day                        : num [1:22230] 1 2 3 4 5 6 7 8 9 10 ...
 $ daily_rainfall_total_mm    : num [1:22230] 0 0 0 0 6.2 0 0 14.9 0 0 ...
 $ highest_30_min_rainfall_mm : num [1:22230] NA NA NA NA NA NA NA NA NA NA ...
 $ highest_60_min_rainfall_mm : num [1:22230] NA NA NA NA NA NA NA NA NA NA ...
 $ highest_120_min_rainfall_mm: num [1:22230] NA NA NA NA NA NA NA NA NA NA ...
 $ mean_temperature_c         : num [1:22230] 29.5 30 30.3 30.4 29 29.1 29.4 28.6 29.1 29.2 ...
 $ maximum_temperature_c      : num [1:22230] 34.2 33.8 33.1 33.5 34 32.7 33.1 31.6 32.7 33 ...
 $ minimum_temperature_c      : num [1:22230] 26.1 25.8 26.7 26.9 26 26.2 26 26 25.8 25.3 ...
 $ mean_wind_speed_km_h       : num [1:22230] 11.9 13 15.8 11.2 7.2 15.8 16.6 12.6 16.9 16.6 ...
 $ max_wind_speed_km_h        : num [1:22230] 42.5 46.4 48.2 35.3 31.3 38.9 42.5 33.5 42.5 42.5 ...
 $ date                       : Date[1:22230], format: "2019-01-01" "2019-01-02" ...

ggplot(station, 
       aes(x = mean_temperature_c, y = station, fill = station)) +
  geom_density_ridges(
    scale = 2, 
    rel_min_height = 0.01, 
    alpha = 0.5
  ) +
  labs(title = "Distribution of Temperature Across Stations",
       x = "Mean Temperature (°C)", 
       y = "Station") +
  theme(
    panel.background = element_rect(fill = "#f3f1e9"),
    plot.background = element_rect(fill = "#f3f1e9", color = NA),
    legend.position = "none",
    plot.title = element_text(face = "bold")
  )

Picking joint bandwidth of 0.0966

ggplot(station, 
       aes(x = station,y = mean_temperature_c)) +
  stat_halfeye(
               alpha = 0.5,
               adjust = 0.5,
               justification = -0.1,
               .width = 0,
               fill = "#8AA4FF")+
  geom_boxplot(width = 0.10,
               outlier.shape = NA,
               color="grey50")+
  labs(title ="Distribution of Mean Temperature Across Stations",
       x = "", y="Mean Temperature")+
  coord_flip() +
  theme(panel.background = element_rect(fill = "#ffffff"),
        plot.background = element_rect(fill = "#ffffff",color = NA),
        legend.position = 'none',
        plot.title = element_text(face = "bold",size=13,hjust=0.5))

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

Warning in bandwidth_dpi(): Bandwidth calculation failed.
→ Falling back to `bandwidth_nrd0()`.
ℹ This often occurs when a sample contains many duplicates, which suggests that
  a dotplot (e.g., `geom_dots()`) or histogram (e.g., `density_histogram()`,
  `stat_slab(density = 'histogram')`, or `stat_histinterval()`) may better
  represent the data.
Caused by error in `bw.SJ()`:
! sample is too sparse to find TD

quartile_station_table <- station %>%
  group_by(station) %>%
  summarize(
    Min    = round(min(mean_temperature_c, na.rm = TRUE),2),
    Q1     = round(quantile(mean_temperature_c, probs = 0.25, na.rm = TRUE),2),
    Median = round(median(mean_temperature_c, na.rm = TRUE),2),
    Mean   = round(mean(mean_temperature_c, na.rm = TRUE),2),
    Q3     = round(quantile(mean_temperature_c, probs = 0.75, na.rm = TRUE),2),
    Q4     = round(quantile(mean_temperature_c, probs = 1, na.rm = TRUE),2),
    Max    = round(max(mean_temperature_c, na.rm = TRUE),2)
  )

kable(quartile_station_table)

station	Min	Q1	Median	Mean	Q3	Q4	Max
Admiralty	23.9	28.31	28.31	28.24	28.31	30.1	30.1
Ang Mo Kio	23.7	28.31	28.31	28.27	28.31	30.4	30.4
Changi	24.1	28.31	28.31	28.31	28.31	30.7	30.7
Clementi	23.8	28.31	28.31	28.25	28.31	30.2	30.2
Jurong (West)	23.4	28.31	28.31	28.18	28.31	30.8	30.8
Marina Barrage	24.6	28.31	28.31	28.38	28.31	30.8	30.8
Newton	23.7	28.31	28.31	28.23	28.31	29.9	29.9
Pasir Panjang	24.5	28.31	28.31	28.35	28.31	30.6	30.6
Paya Lebar	24.8	28.31	28.31	28.45	28.31	31.7	31.7
Tai Seng	24.5	28.31	28.31	28.40	28.31	31.0	31.0

pacman::p_load(plotly,ggplot2,dplyr)

# Change to "all" to display all stations
selected_station <- c("Changi", "Marina Barrage","Ang Mo Kio","Clementi","Jurong (West)","Paya Lebar","Newton","Pasir Panjang","Tai Seng","Admiralty"
)

# Filter the data accordingly
station_data <- if ("all" %in% selected_station) {
  station
} else {
  station %>% filter(station %in% selected_station)
}

# Create the plot using the filtered data
p <- ggplot(data = station_data, 
            aes(x = mean_temperature_c,
                y = daily_rainfall_total_mm, 
                color = station)) +
  geom_point(size = 1, alpha = 0.7) +  
  coord_cartesian(ylim = c(0, 150))+
  theme_minimal() +
  labs(x = "Mean Temperature (°C)", y = "Daily Total Rainfall (mm)") +
  theme(
    plot.background = element_rect(fill = "white", color = NA),
    panel.background = element_rect(fill = "white"),
    axis.title = element_text(size = 10, hjust = 0.5),
    axis.text = element_text(size = 8),
    legend.position = "top",
    plot.title = element_text(size = 14, face = "bold", hjust = 0.5)
  )


ggplotly(p)

colnames(station)

 [1] "station"                     "year"                       
 [3] "month"                       "day"                        
 [5] "daily_rainfall_total_mm"     "highest_30_min_rainfall_mm" 
 [7] "highest_60_min_rainfall_mm"  "highest_120_min_rainfall_mm"
 [9] "mean_temperature_c"          "maximum_temperature_c"      
[11] "minimum_temperature_c"       "mean_wind_speed_km_h"       
[13] "max_wind_speed_km_h"         "date"                       

# Replace missing values in mean_temperature_c, Maximum, and Minimum
station <- station %>%
  mutate(
    mean_temperature_c = ifelse(!is.na(mean_temperature_c), 
                                mean_temperature_c, 
                                mean(mean_temperature_c, na.rm = TRUE)), 
    maximum_temperature_c = ifelse(!is.na(maximum_temperature_c), 
                                   maximum_temperature_c, 
                                   max(maximum_temperature_c, na.rm = TRUE)),  
    minimum_temperature_c = ifelse(!is.na(minimum_temperature_c), 
                                   minimum_temperature_c, 
                                   min(minimum_temperature_c, na.rm = TRUE))   
)

colSums(is.na(station))

                    station                        year 
                          0                           0 
                      month                         day 
                          0                           0 
    daily_rainfall_total_mm  highest_30_min_rainfall_mm 
                        278                       18170 
 highest_60_min_rainfall_mm highest_120_min_rainfall_mm 
                      18170                       18170 
         mean_temperature_c       maximum_temperature_c 
                          0                           0 
      minimum_temperature_c        mean_wind_speed_km_h 
                          0                        1092 
        max_wind_speed_km_h                        date 
                        968                           0 

# Create the Date column
station <- station %>%
  mutate(date = as.Date(paste(year, month, day, sep = "-"), format = "%Y-%m-%d"))

# Filter only Changi site data
changi_data <- subset(station, station == "Changi")

# Drawing
ggplot(changi_data, aes(x = date, y = mean_wind_speed_km_h, color = station, group = station)) +
  geom_line(linewidth = 1, alpha = 0.8) +
  theme_minimal() +
  labs(title = "Mean Wind Speed Over Time at Changi",
       x = "Date",
       y = "Mean Wind Speed (km/h)") +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    legend.title = element_blank(),
    legend.position = "top"
  )

pacman::p_load(shiny,ggplot2,dplyr)
# Create the Date column
station <- station %>%
  mutate(date = as.Date(paste(year, month, day, sep = "-"), format = "%Y-%m-%d"))

# Create a Shiny application
ui <- fluidPage(
  titlePanel("Wind Speed Over Time by Station"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("selected_station", "Select Station:", choices = unique(station$station))
    ),
    
    mainPanel(
      plotOutput("wind_speed_plot")
    )
  )
)

server <- function(input, output) {
  output$wind_speed_plot <- renderPlot({
   # Filter the site selected by the user
    filtered_data <- subset(station, station == input$selected_station)
    
   # Drawing
    ggplot(filtered_data, aes(x = date, y = mean_wind_speed_km_h, color = station, group = station)) +
      geom_line(linewidth = 1, alpha = 0.8) +
      theme_minimal() +
      labs(title = paste("Mean Wind Speed Over Time -", input$selected_station),
           x = "Date",
           y = "Mean Wind Speed (km/h)") +
      theme(
        plot.title = element_text(face = "bold", hjust = 0.5),
        legend.title = element_blank(),
        legend.position = "top"
      )
  })
}

shinyApp(ui, server)

PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

Shiny applications not supported in static R Markdown documents